home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / socketx / ECHOFN.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1998-10-31  |  12.4 KB  |  371 lines
  1. VERSION 5.00
  2. Object = "{C7212F93-30E8-11D2-B450-0020AFD69DE6}#1.0#0"; "SocketX.OCX"
  3. Begin VB.Form Form1 
  4.    Caption         =   "Form1"
  5.    ClientHeight    =   6945
  6.    ClientLeft      =   1095
  7.    ClientTop       =   1485
  8.    ClientWidth     =   7365
  9.    BeginProperty Font 
  10.       Name            =   "MS Sans Serif"
  11.       Size            =   8.25
  12.       Charset         =   0
  13.       Weight          =   700
  14.       Underline       =   0   'False
  15.       Italic          =   0   'False
  16.       Strikethrough   =   0   'False
  17.    EndProperty
  18.    ForeColor       =   &H80000008&
  19.    KeyPreview      =   -1  'True
  20.    LinkTopic       =   "Form1"
  21.    PaletteMode     =   1  'UseZOrder
  22.    ScaleHeight     =   6945
  23.    ScaleWidth      =   7365
  24.    Begin SocketXCtl.SocketXCtl SocketX 
  25.       Left            =   600
  26.       Top             =   6000
  27.       AcceptTimeout   =   0
  28.       BlockingMode    =   -842150451
  29.       Blocking        =   -1  'True
  30.       BroadcastEnabled=   -1  'True
  31.       ConnectTimeout  =   0
  32.       EventMask       =   63
  33.       KeepAliveEnabled=   0   'False
  34.       LibraryName     =   "WSOCK32.DLL"
  35.       LingerEnabled   =   0   'False
  36.       LingerMode      =   0
  37.       LingerTime      =   0
  38.       LocalAddress    =   ""
  39.       LocalPort       =   0
  40.       OutOfBandEnabled=   0   'False
  41.       ReceiveBufferSize=   8192
  42.       ReceiveTimeout  =   0
  43.       RemoteAddress   =   ""
  44.       RemoteName      =   ""
  45.       ReuseAddressEnabled=   0   'False
  46.       RemotePort      =   0
  47.       RouteEnabled    =   -1  'True
  48.       SendTimeout     =   8192
  49.       SendBufferSize  =   0
  50.       SocketType      =   0
  51.       TcpNoDelayEnabled=   0   'False
  52.    End
  53.    Begin VB.TextBox txtPort 
  54.       BeginProperty Font 
  55.          Name            =   "MS Sans Serif"
  56.          Size            =   8.25
  57.          Charset         =   0
  58.          Weight          =   400
  59.          Underline       =   0   'False
  60.          Italic          =   0   'False
  61.          Strikethrough   =   0   'False
  62.       EndProperty
  63.       Height          =   285
  64.       Left            =   4560
  65.       TabIndex        =   6
  66.       Text            =   "7"
  67.       Top             =   5520
  68.       Width           =   495
  69.    End
  70.    Begin VB.CheckBox chkLocalEcho 
  71.       Caption         =   "Local Echo"
  72.       BeginProperty Font 
  73.          Name            =   "MS Sans Serif"
  74.          Size            =   8.25
  75.          Charset         =   0
  76.          Weight          =   400
  77.          Underline       =   0   'False
  78.          Italic          =   0   'False
  79.          Strikethrough   =   0   'False
  80.       EndProperty
  81.       Height          =   255
  82.       Left            =   5280
  83.       TabIndex        =   4
  84.       Top             =   5520
  85.       Width           =   1215
  86.    End
  87.    Begin VB.CommandButton Command1 
  88.       Appearance      =   0  'Flat
  89.       BackColor       =   &H80000005&
  90.       Caption         =   "Connect"
  91.       BeginProperty Font 
  92.          Name            =   "MS Sans Serif"
  93.          Size            =   8.25
  94.          Charset         =   0
  95.          Weight          =   400
  96.          Underline       =   0   'False
  97.          Italic          =   0   'False
  98.          Strikethrough   =   0   'False
  99.       EndProperty
  100.       Height          =   375
  101.       Left            =   120
  102.       TabIndex        =   3
  103.       Top             =   5520
  104.       Width           =   1095
  105.    End
  106.    Begin VB.TextBox txtServer 
  107.       BeginProperty Font 
  108.          Name            =   "MS Sans Serif"
  109.          Size            =   8.25
  110.          Charset         =   0
  111.          Weight          =   400
  112.          Underline       =   0   'False
  113.          Italic          =   0   'False
  114.          Strikethrough   =   0   'False
  115.       EndProperty
  116.       Height          =   285
  117.       Left            =   2160
  118.       TabIndex        =   2
  119.       Text            =   "12.2.15.57"
  120.       Top             =   5520
  121.       Width           =   1695
  122.    End
  123.    Begin VB.TextBox txtTranscript 
  124.       BeginProperty Font 
  125.          Name            =   "Courier New"
  126.          Size            =   8.25
  127.          Charset         =   0
  128.          Weight          =   400
  129.          Underline       =   0   'False
  130.          Italic          =   0   'False
  131.          Strikethrough   =   0   'False
  132.       EndProperty
  133.       Height          =   5175
  134.       Left            =   120
  135.       MultiLine       =   -1  'True
  136.       ScrollBars      =   3  'Both
  137.       TabIndex        =   0
  138.       Top             =   120
  139.       Width           =   7095
  140.    End
  141.    Begin VB.Label Label4 
  142.       Caption         =   "If you are not connecting to a remote echo port (7) you should check the Local Echo box."
  143.       BeginProperty Font 
  144.          Name            =   "MS Sans Serif"
  145.          Size            =   8.25
  146.          Charset         =   0
  147.          Weight          =   400
  148.          Underline       =   0   'False
  149.          Italic          =   0   'False
  150.          Strikethrough   =   0   'False
  151.       EndProperty
  152.       Height          =   855
  153.       Left            =   5280
  154.       TabIndex        =   8
  155.       Top             =   5880
  156.       Width           =   2055
  157.    End
  158.    Begin VB.Label Label1 
  159.       Alignment       =   1  'Right Justify
  160.       Appearance      =   0  'Flat
  161.       BackColor       =   &H00C0C0C0&
  162.       Caption         =   "Port:"
  163.       BeginProperty Font 
  164.          Name            =   "MS Sans Serif"
  165.          Size            =   8.25
  166.          Charset         =   0
  167.          Weight          =   400
  168.          Underline       =   0   'False
  169.          Italic          =   0   'False
  170.          Strikethrough   =   0   'False
  171.       EndProperty
  172.       ForeColor       =   &H80000008&
  173.       Height          =   255
  174.       Left            =   4080
  175.       TabIndex        =   7
  176.       Top             =   5520
  177.       Width           =   375
  178.    End
  179.    Begin VB.Label Label3 
  180.       Caption         =   "Note: Not all servers you might choose support connections to all ports."
  181.       BeginProperty Font 
  182.          Name            =   "MS Sans Serif"
  183.          Size            =   8.25
  184.          Charset         =   0
  185.          Weight          =   400
  186.          Underline       =   0   'False
  187.          Italic          =   0   'False
  188.          Strikethrough   =   0   'False
  189.       EndProperty
  190.       Height          =   615
  191.       Left            =   2160
  192.       TabIndex        =   5
  193.       Top             =   6000
  194.       Width           =   2055
  195.    End
  196.    Begin VB.Label Label2 
  197.       Alignment       =   1  'Right Justify
  198.       Appearance      =   0  'Flat
  199.       BackColor       =   &H00C0C0C0&
  200.       Caption         =   "Server:"
  201.       BeginProperty Font 
  202.          Name            =   "MS Sans Serif"
  203.          Size            =   8.25
  204.          Charset         =   0
  205.          Weight          =   400
  206.          Underline       =   0   'False
  207.          Italic          =   0   'False
  208.          Strikethrough   =   0   'False
  209.       EndProperty
  210.       ForeColor       =   &H80000008&
  211.       Height          =   255
  212.       Left            =   1440
  213.       TabIndex        =   1
  214.       Top             =   5520
  215.       Width           =   615
  216.    End
  217. Attribute VB_Name = "Form1"
  218. Attribute VB_GlobalNameSpace = False
  219. Attribute VB_Creatable = False
  220. Attribute VB_PredeclaredId = True
  221. Attribute VB_Exposed = False
  222. Option Explicit
  223. Implements ISocketXCtlNotify
  224. Dim transcriptHasFocus As Integer
  225. Private Sub AddToTranscript(ByVal s As String)
  226.     Dim newtext As String
  227.     Dim i As Integer
  228.     Dim p As Integer
  229.     Dim fixup As Integer
  230.     For i = 1 To Len(s)
  231.         fixup = False
  232.         Select Case Asc(Mid(s, i, 1))
  233.             Case 13
  234.                 If (i < Len(s)) Then
  235.                     If (Mid(s, i + 1, 1) <> Chr(10)) Then
  236.                         fixup = True
  237.                     Else
  238.                         newtext = newtext & Chr(13)
  239.                     End If
  240.                 Else
  241.                     fixup = True
  242.                 End If
  243.             Case 10
  244.                 If (i > 1) Then
  245.                     If (Mid(s, i - 1, 1) <> Chr(13)) Then
  246.                         fixup = True
  247.                     Else
  248.                         newtext = newtext & Chr(10)
  249.                     End If
  250.                 Else
  251.                     fixup = True
  252.                 End If
  253.             Case Else
  254.                 newtext = newtext & Mid(s, i, 1)
  255.         End Select
  256.         If (fixup) Then
  257.             newtext = newtext & Chr(13) & Chr(10)
  258.         End If
  259.     Next
  260.     txtTranscript.Text = txtTranscript.Text & newtext
  261.     txtTranscript.SelStart = Len(txtTranscript.Text) + 1
  262. End Sub
  263. Private Sub Command1_Click()
  264.     Dim i      As Integer
  265.     Dim addr   As String
  266.     Dim lookup As Integer
  267.     Dim c      As String
  268.     txtTranscript.SetFocus
  269.     Command1.Enabled = False
  270.     If (Command1.Caption = "Disconnect") Then
  271.         SocketX.Close
  272.         Command1.Caption = "Connect"
  273.         Command1.Enabled = True
  274.         Exit Sub
  275.     End If
  276.     SocketX.Create
  277.     addr = txtServer.Text
  278.     '
  279.     ' Check to see if name lookup required
  280.     '
  281.     lookup = False
  282.     For i = 1 To Len(addr)
  283.         c = Mid(addr, i, 1)
  284.         If (c <> "." And (c < "0" Or c > "9")) Then
  285.             '
  286.             ' Found a non-numeric character that is not
  287.             ' a dot, need to do a name lookup
  288.             '
  289.             lookup = True
  290.             Exit For
  291.         End If
  292.     Next
  293.     If (lookup) Then
  294.         SocketX.RemoteNameAddrXlate = True
  295.         SocketX.RemoteName = addr
  296.         txtServer.Text = SocketX.RemoteAddress
  297.     Else
  298.         SocketX.RemoteAddress = addr
  299.     End If
  300.     SocketX.RemoteNameAddrXlate = False
  301.     SocketX.RemotePort = CInt(txtPort.Text)
  302.     SocketX.Connect
  303. End Sub
  304. Private Sub Form_KeyPress(keyascii As Integer)
  305.     If (transcriptHasFocus) Then
  306.         If (SocketX.State >= soxConnected) Then
  307.             If (keyascii = 13) Then
  308.                 SocketX.SendBuffer = Chr(13) & Chr(10)
  309.             Else
  310.                 SocketX.SendBuffer = Chr(keyascii)
  311.             End If
  312.             If (chkLocalEcho.Value = 1) Then
  313.                 AddToTranscript CStr(SocketX.SendBuffer)
  314.             End If
  315.             SocketX.Send
  316.         End If
  317.         keyascii = 0
  318.     End If
  319. End Sub
  320. Private Sub Form_Load()
  321.     SocketX.SocketType = soxStream
  322.     SocketX.Blocking = False
  323.     SocketX.EventMask = -1
  324.     SocketX.NotificationObject = Me
  325. End Sub
  326. Private Sub ISocketXCtlNotify_Accept(ByVal SocketXCtl As SocketXCtl.ISocketXCtl, ByVal SocketHandle As Long, ByVal ErrorCode As Integer)
  327.     AddToTranscript "*** Accept ***"
  328. End Sub
  329. Private Sub ISocketXCtlNotify_Close(ByVal SocketXCtl As SocketXCtl.ISocketXCtl, ByVal ErrorCode As Integer)
  330.     AddToTranscript "*** OnClose ***" & Chr(13)
  331.     Command1.Caption = "Connect"
  332.     Command1.Enabled = True
  333. End Sub
  334. Private Sub ISocketXCtlNotify_Connect(ByVal SocketXCtl As SocketXCtl.ISocketXCtl, ByVal ErrorCode As Integer)
  335.     If (ErrorCode = 0) Then
  336.         AddToTranscript "*** OnConnect ***" & Chr(13)
  337.         Command1.Caption = "Disconnect"
  338.     ElseIf (ErrorCode = 10060) Then
  339.         AddToTranscript "Connection timed out"
  340.     Else
  341.         AddToTranscript "Unexpected error " & ErrorCode & Chr(13) & "   " & SocketXCtl.LastErrorString & Chr(13)
  342.     End If
  343.     Command1.Enabled = True
  344. End Sub
  345. Private Sub ISocketXCtlNotify_Done(ByVal SocketXCtl As SocketXCtl.ISocketXCtl, ByVal LastMethod As SocketXCtl.MethodsEnum, ByVal ErrorCode As Integer)
  346.     If (LastMethod <> soxReceive And LastMethod <> soxSend) Then
  347.         AddToTranscript "Done(" & LastMethod & "," & ErrorCode & ")" & Chr(13)
  348.     End If
  349. End Sub
  350. Private Sub ISocketXCtlNotify_OutOfBandData(ByVal SocketXCtl As SocketXCtl.ISocketXCtl, ByVal ErrorCode As Integer)
  351.     AddToTranscript "*** Out of band data received ***"
  352. End Sub
  353. Private Sub ISocketXCtlNotify_Receive(ByVal SocketXCtl As SocketXCtl.ISocketXCtl, ByVal ErrorCode As Integer)
  354.     SocketXCtl.Receive
  355.     If (ErrorCode = 0) Then
  356.         AddToTranscript CStr(SocketXCtl.ReceiveBuffer)
  357.     Else
  358.         AddToTranscript "*** Receive Error " & ErrorCode & " ***"
  359.     End If
  360. End Sub
  361. Private Sub ISocketXCtlNotify_Send(ByVal SocketXCtl As SocketXCtl.ISocketXCtl, ByVal ErrorCode As Integer)
  362.     AddToTranscript "*** Send ***" & Chr(13)
  363.     MsgBox "The Send event occured, you can start typing now."
  364. End Sub
  365. Private Sub txtTranscript_GotFocus()
  366.     transcriptHasFocus = True
  367. End Sub
  368. Private Sub txtTranscript_LostFocus()
  369.     transcriptHasFocus = False
  370. End Sub
  371.